home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 08 - 1992 / 08.03 Jul 92 / Matrix Parser / EvaluateNodes < prev    next >
Encoding:
Text File  |  1992-12-24  |  8.9 KB  |  393 lines  |  [TEXT/PJMM]
  1. unit EvaluateNodes;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Globals, Commands, MatrixFunctions, MatrixOperations, Inverse;
  7.  
  8.     procedure evaluatenodes (var nodetable: hdlarrayhdlnoderecord; var numnodes: longint; var mrows, ncols: longint; var t: hdlextendarray; var store: boolean; var save: array2; var error: str255);
  9.  
  10.  
  11. implementation
  12.  
  13.  
  14.     procedure evaluatenodes;
  15.  
  16.  
  17.         label
  18.             888, 995, 998, 999;
  19.  
  20.  
  21.         var
  22.  
  23.             i, j, k, lm, mn, kmat: longint;
  24.             m1, n1, m2, n2, rowmax, colmax: longint;
  25.             rank: longint;
  26.             b1, b2, rows, cols: extended;
  27.             realbinoperator, dummyname: stringsize;
  28.             matrixoper: string30;
  29.             r, realresult, condnum, determ: extended;
  30.             amat, bmat, cmat: hdlsinglearraymatrix;
  31.             anew, bnew, cnew: boolean;
  32.             vRefNum: longint;
  33.             err: OSErr;
  34.             name: str255;
  35.             fileinfo: fInfo;
  36.  
  37.         procedure OpenMatrixFile (var matpointer: longint; var mrows, ncols: longint; var dummymatrix: hdlsinglearraymatrix);
  38.  
  39.  
  40.             var
  41.                 index: longint;
  42.                 rows, cols: extended;
  43.  
  44.         begin
  45.  
  46.             if not mfileopen^^[matpointer] then
  47.                 begin
  48.                     open(matfile^^[matpointer]^^, strvar^^[matpointer]^^);
  49.                     mfileopen^^[matpointer] := true;
  50.                 end;
  51.  
  52.             reset(matfile^^[matpointer]^^);
  53.  
  54.             read(matfile^^[matpointer]^^, rows);
  55.             read(matfile^^[matpointer]^^, cols);
  56.  
  57.             mrows := round(rows);
  58.             ncols := round(cols);
  59.  
  60.             blocksize := longint(10 * mrows * ncols + 20);
  61.             dummymatrix := hdlsinglearraymatrix(NewHandle(blocksize));
  62.  
  63.             dummymatrix^^[1] := mrows;
  64.             dummymatrix^^[2] := ncols;
  65.             for index := 3 to mrows * ncols + 2 do
  66.                 read(matfile^^[matpointer]^^, dummymatrix^^[index]);
  67.  
  68.             if mfileopen^^[matpointer] then
  69.                 begin
  70.                     close(matfile^^[matpointer]^^);
  71.                     mfileopen^^[matpointer] := false;
  72.                 end;
  73.  
  74.         end;
  75.  
  76.  
  77.         procedure GetMatrix (var matpointer: longint; var dummymatrix: hdlsinglearraymatrix);
  78.  
  79.             var
  80.                 index: longint;
  81.  
  82.         begin
  83.  
  84.             if matrixstoredinfile^^[matpointer] then
  85.                 OpenMatrixFile(matpointer, mrows, ncols, dummymatrix);
  86.  
  87.             if not matrixstoredinfile^^[matpointer] then
  88.                 begin
  89.                     mrows := round(storematrix^^[matpointer]^^[1]);
  90.                     ncols := round(storematrix^^[matpointer]^^[2]);
  91.                     blocksize := longint(10 * mrows * ncols + 20);
  92.                     dummymatrix := hdlsinglearraymatrix(NewHandle(blocksize));
  93.                     for index := 1 to mrows * ncols + 2 do
  94.                         dummymatrix^^[index] := storematrix^^[matpointer]^^[index];
  95.                 end;
  96.  
  97.         end;
  98.  
  99.         procedure GetNodeMatrix (var matpointer: longint; var dummymatrix: hdlsinglearraymatrix);
  100.  
  101.             var
  102.                 index: longint;
  103.  
  104.         begin
  105.  
  106.             mrows := round(nodematrix^^[matpointer]^^[1]);
  107.             ncols := round(nodematrix^^[matpointer]^^[2]);
  108.             blocksize := longint(10 * mrows * ncols + 20);
  109.             dummymatrix := hdlsinglearraymatrix(NewHandle(blocksize));
  110.             for index := 1 to mrows * ncols + 2 do
  111.                 dummymatrix^^[index] := nodematrix^^[matpointer]^^[index];
  112.  
  113.         end;
  114.  
  115.         procedure GetConstantMatrix (var realnumber: extended; var dummymatrix: hdlsinglearraymatrix);
  116.  
  117.         begin
  118.             mrows := 1;
  119.             ncols := 1;
  120.             blocksize := longint(30);
  121.             dummymatrix := hdlsinglearraymatrix(NewHandle(blocksize));
  122.             dummymatrix^^[1] := 1;
  123.             dummymatrix^^[2] := 1;
  124.             dummymatrix^^[3] := realnumber;
  125.         end;
  126.  
  127.     begin
  128.  
  129.         error := '';
  130.  
  131.         amat := nil;
  132.         bmat := nil;
  133.         cmat := nil;
  134.  
  135.         anew := false;
  136.         bnew := false;
  137.         cnew := false;
  138.  
  139.         for i := 1 to numnodes do
  140.             begin
  141.  
  142.                 t^^[i] := hdlextended(NewHandle(SizeOf(extended)));
  143.  
  144.                 readstring(nodetable^^[i]^^.rop.index, b2);
  145.                 mn := round(b2);
  146.  
  147.                 if nodetable^^[i]^^.roptype = 'node' then
  148.                     begin
  149.                         b2 := t^^[mn]^^;
  150.                         mn := round(b2);
  151.                         GetNodeMatrix(mn, dummymatrix);
  152.                     end;
  153.  
  154.                 if nodetable^^[i]^^.roptype = 'constant' then
  155.                     GetConstantMatrix(b2, dummymatrix);
  156.  
  157.                 if nodetable^^[i]^^.roptype = 'matrix' then
  158.                     GetMatrix(mn, dummymatrix);
  159.  
  160.                 blocksize := longint(10 * mrows * ncols + 20);
  161.                 bmat := hdlsinglearraymatrix(NewHandle(blocksize));
  162.                 bnew := true;
  163.  
  164.                 for j := 1 to mrows * ncols + 2 do
  165.                     bmat^^[j] := dummymatrix^^[j];
  166.  
  167.                 m2 := round(bmat^^[1]);
  168.                 n2 := round(bmat^^[2]);
  169.  
  170.  
  171.                 if (nodetable^^[i]^^.op.index = equals) then
  172.                     begin
  173.                         t^^[i]^^ := i;
  174.  
  175.                         blocksize := longint(10 * mrows * ncols + 20);
  176.                         nodematrix^^[i] := hdlsinglearraymatrix(NewHandle(blocksize));
  177.  
  178.                         for j := 1 to mrows * ncols + 2 do
  179.                             nodematrix^^[i]^^[j] := dummymatrix^^[j];
  180.  
  181.                         goto 888;
  182.                     end;
  183.  
  184.  
  185.                 matrixoper := nodetable^^[i]^^.op.index;
  186.  
  187.                 if ((nodetable^^[i]^^.optype = 'unary') or (nodetable^^[i]^^.optype = 'function')) then
  188.                     begin
  189.  
  190.                         if matrixoper = minus then
  191.                             for k := 3 to mrows * ncols + 2 do
  192.                                 dummymatrix^^[k] := -dummymatrix^^[k]
  193.  
  194.                         else if matrixoper = quote then
  195.                             matrixtranspose(dummymatrix, mrows, ncols, matrixoper)
  196.  
  197.                         else if matrixoper = 'inv' then
  198.                             Inverse(dummymatrix, mrows, ncols, error)
  199.  
  200.                         else
  201.                             matrixfunctions(dummymatrix, mrows, ncols, matrixoper, realresult);
  202.  
  203.  
  204.                         t^^[i]^^ := i;
  205.  
  206.                         blocksize := longint(10 * mrows * ncols + 20);
  207.                         nodematrix^^[i] := hdlsinglearraymatrix(NewHandle(blocksize));
  208.  
  209.                         for j := 1 to mrows * ncols + 2 do
  210.                             nodematrix^^[i]^^[j] := dummymatrix^^[j];
  211.  
  212.                         goto 888;
  213.                     end;
  214.  
  215.  
  216.                 readstring(nodetable^^[i]^^.lop.index, b1);
  217.                 lm := round(b1);
  218.  
  219.                 if nodetable^^[i]^^.loptype = 'node' then
  220.                     begin
  221.                         b1 := t^^[lm]^^;
  222.                         lm := round(b1);
  223.                         GetNodeMatrix(lm, dummymatrix);
  224.                     end;
  225.  
  226.                 if nodetable^^[i]^^.loptype = 'matrix' then
  227.                     GetMatrix(lm, dummymatrix);
  228.  
  229.                 if nodetable^^[i]^^.loptype = 'constant' then
  230.                     GetConstantMatrix(b1, dummymatrix);
  231.  
  232.                 blocksize := longint(10 * mrows * ncols + 20);
  233.                 amat := hdlsinglearraymatrix(NewHandle(blocksize));
  234.                 anew := true;
  235.  
  236.                 for j := 1 to mrows * ncols + 2 do
  237.                     amat^^[j] := dummymatrix^^[j];
  238.  
  239.                 m1 := round(amat^^[1]);
  240.                 n1 := round(amat^^[2]);
  241.  
  242.                 if (matrixoper = asterisk) then
  243.                     blocksize := longint(10 * m1 * n2 + 20);
  244.  
  245.                 if (matrixoper <> asterisk) then
  246.                     begin
  247.                         rowmax := m1;
  248.                         colmax := n1;
  249.                         if (m2 >= rowmax) then
  250.                             rowmax := m2;
  251.                         if (n2 >= colmax) then
  252.                             colmax := n2;
  253.                         blocksize := longint(10 * rowmax * colmax + 20);
  254.                     end;
  255.  
  256.                 cmat := hdlsinglearraymatrix(NewHandle(blocksize));
  257.                 cnew := true;
  258.  
  259.                 matrixoperations(amat, bmat, cmat, m1, n1, m2, n2, mrows, ncols, matrixoper, error, realresult);
  260.  
  261.                 if error <> '' then
  262.                     goto 999;
  263.  
  264.  
  265.                 t^^[i]^^ := i;
  266.                 nodematrix^^[i] := hdlsinglearraymatrix(NewHandle(blocksize));
  267.  
  268.                 for j := 1 to mrows * ncols + 2 do
  269.                     nodematrix^^[i]^^[j] := cmat^^[j];
  270.  
  271. 888:
  272.                 if anew then
  273.                     begin
  274.                         DisposHandle(handle(amat));
  275.                         amat := nil;
  276.                         anew := false;
  277.                     end;
  278.  
  279.                 if bnew then
  280.                     begin
  281.                         DisposHandle(handle(bmat));
  282.                         bmat := nil;
  283.                         bnew := false;
  284.                     end;
  285.  
  286.                 if cnew then
  287.                     begin
  288.                         DisposHandle(handle(cmat));
  289.                         cmat := nil;
  290.                         cnew := false;
  291.                     end;
  292.  
  293.  
  294.             end;
  295.  
  296.  
  297. 995:
  298.  
  299.         for i := 1 to numnodes - 1 do
  300.             begin
  301.                 DisposHandle(handle(nodematrix^^[i]));
  302.                 nodematrix^^[i] := nil;
  303.                 DisposHandle(handle(t^^[i]));
  304.                 t^^[i] := nil;
  305.             end;
  306.  
  307.         mrows := round(nodematrix^^[numnodes]^^[1]);
  308.         ncols := round(nodematrix^^[numnodes]^^[2]);
  309.         blocksize := longint(10 * mrows * ncols + 20);
  310.  
  311.         if save[2] <> equals then
  312.             goto 998;
  313.  
  314.         createamatrix(save[1], mrows, ncols, k);
  315.  
  316.         if matrixstoredinfile^^[k] then
  317.             begin
  318.  
  319.                 if not mfileopen^^[k] then
  320.                     begin
  321.                         open(matfile^^[k]^^, strvar^^[k]^^);   {Open up the file, matfile^^[k], and prepare it}
  322.                         mfileopen^^[k] := true;                              {for writing.}
  323.                     end;
  324.  
  325.                 rewrite(matfile^^[k]^^);
  326.  
  327.                 for j := 1 to mrows * ncols + 2 do
  328.                     write(matfile^^[k]^^, nodematrix^^[numnodes]^^[j]);
  329.  
  330.                 if mfileopen^^[k] then
  331.                     begin
  332.                         close(matfile^^[k]^^);
  333.                         mfileopen^^[k] := false;
  334.                     end;
  335.             end;
  336.  
  337.         if not matrixstoredinfile^^[k] then
  338.             for j := 1 to mrows * ncols + 2 do
  339.                 storematrix^^[k]^^[j] := nodematrix^^[numnodes]^^[j];
  340.  
  341. 998:
  342.  
  343.         dummyname := 'ans';
  344.         createamatrix(dummyname, mrows, ncols, k);
  345.  
  346.         if matrixstoredinfile^^[k] then
  347.             begin
  348.  
  349.                 if not mfileopen^^[k] then
  350.                     begin
  351.                         open(matfile^^[k]^^, strvar^^[k]^^);              {Open up the file, matfile^^[k], and prepare it}
  352.                         mfileopen^^[k] := true;                                 {for writing.}
  353.                     end;
  354.  
  355.                 rewrite(matfile^^[k]^^);
  356.  
  357.                 for j := 1 to mrows * ncols + 2 do
  358.                     write(matfile^^[k]^^, nodematrix^^[numnodes]^^[j]);
  359.  
  360.                 if mfileopen^^[k] then
  361.                     begin
  362.                         close(matfile^^[k]^^);
  363.                         mfileopen^^[k] := false;
  364.                     end;
  365.             end;
  366.  
  367.         if not matrixstoredinfile^^[k] then
  368.             for j := 1 to mrows * ncols + 2 do
  369.                 storematrix^^[k]^^[j] := nodematrix^^[numnodes]^^[j];
  370.  
  371.         name := strvar^^[k]^^;
  372.         vRefNum := 2;
  373.         fileinfo.fdFlags := fInvisible;
  374.         err := SetFInfo(name, vRefNum, fileinfo);
  375.  
  376.         if (mrows = 1) and (ncols = 1) then
  377.             t^^[numnodes]^^ := nodematrix^^[numnodes]^^[3]
  378.         else
  379.             t^^[numnodes]^^ := k;
  380.  
  381. 999:
  382.  
  383.         DisposHandle(handle(dummymatrix));
  384.         dummymatrix := nil;
  385.         DisposHandle(handle(nodematrix^^[numnodes]));
  386.         nodematrix^^[numnodes] := nil;
  387.  
  388.         cleanupvariables;
  389.  
  390.     end;
  391.  
  392.  
  393. end.